home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / newsgrp / group97b.txt / 000013_icon-group-sender _Fri Jul 4 07:51:24 1997.msg < prev    next >
Internet Message Format  |  2000-09-20  |  13KB
  1. Received: from kingfisher.CS.Arizona.EDU by cheltenham.cs.arizona.edu; Tue, 8 Jul 1997 08:45:21 MST
  2. Received: by kingfisher.CS.Arizona.EDU; (5.65v3.2/1.1.8.2/08Nov94-0446PM)
  3.     id AA24535; Tue, 8 Jul 1997 08:45:20 -0700
  4. Posted-Date: Fri, 4 Jul 1997 07:51:24 -0500 (CDT)
  5. Date: Fri, 4 Jul 1997 07:51:24 -0500 (CDT)
  6. From: Chris Tenaglia <cdt@post.its.mcw.edu>
  7. To: icon-group@cs.arizona.edu
  8. Subject: 4th of July Sample 1
  9. Message-Id: <Pine.SOL.3.96.970704073852.21094A-100000@post.its.mcw.edu>
  10. Mime-Version: 1.0
  11. Content-Type: TEXT/PLAIN; charset=US-ASCII
  12. Errors-To: icon-group-errors@cs.arizona.edu
  13. Status: RO
  14.  
  15. Here's a sample program to celebrate this 4th of July with.
  16. It's not a firecracker program, but just yet another menu.
  17. I know, the web seems to make it a moot point but it's a
  18. big chunk of code, and I even use it myself.
  19. This one is nice though, because it only need to be compiled
  20. once. It feeds on menu data files in the format:
  21.  
  22. This is the title line
  23. pine:Pine Email
  24. ftp:File transfer program
  25. [whoami:Who Am I
  26. ?w:Currently logged in users
  27. lynx:Browse the Web
  28. menu games.dat:Games Menu
  29. q:quit
  30.  
  31. The ? prefix puts the output in a file viewer.
  32. The [ prefix takes small output and puts it in a screen box.
  33. The default menu file is menu.dat but you can like to
  34. submenus as well. There are variables that let you customize
  35. it to your company. You can navigate using the arrows or pressing
  36. the first letter of the entry. It works with most vt emulations
  37. and a few others. And now for the code!
  38.  
  39. ####################  BEGIN PROGRAM  ###########################
  40. #
  41. # file : menu.icn
  42. # desc : a generalized menuing system designed for unix
  43. # use  : menu menu_data
  44. #      : menu_data is a file with the following items
  45. #                  first line is the title line
  46. #                  subsequent lines contain verb:Description
  47. #        and menus can call other menus
  48. #
  49. # update          by          what
  50. # 28-apr-1997     tenaglia    initial write
  51. #
  52. global company,viewer
  53. procedure main(param)
  54.   company  := "Medical College of WI"
  55.   viewer   := "see"
  56.   source   := param[1]   | "menu.dat"
  57.   (in := open(source)) | stop("Can't read ",source)
  58.   username := getenv("USER")
  59.   title    := center(read(in),79)
  60.   ff       := "\"\\f\""
  61.   widest   := 20
  62.   vector   := table("")
  63.   verbs    := []
  64.   jects    := []
  65.   while line := read(in) do
  66.     {
  67.     action              := parse(line,':')[1]
  68.     description         := parse(line,':')[2]
  69.     vector[description] := action
  70.     widest             <:= *description
  71.     put(verbs,action)
  72.     put(jects,description)
  73.     }
  74.   close(in)
  75.   widest +:= 2
  76.  
  77.   if *verbs > 20 then stop("Menu data over 20. Too big!")
  78.   if widest > 70 then stop("Menu data is too wide!")
  79.  
  80.   every i := 1 to *jects do jects[i] := left(jects[i],widest-2)
  81.   x := (80 - widest) / 2
  82.   y := (23 - *verbs + 1) / 2
  83.   repeat {
  84.   write("\e[2J\e[H",company,"| ",&dateline,
  85.     " | ",&host," | ",username)
  86.   write("\e[1;7m",title,"\e[0m")
  87.   uclist(y,x,jects)
  88.   writes(at(y+1,x+2),"\e[1m",jects[1],"\e[0m")
  89.   i := 1
  90.   r := y+1
  91.   c := x+2
  92.   repeat
  93.     {
  94.     writes(at(r,c),"\e[1;7m",left(jects[i],widest-2),"\e[0m")
  95.     k := getkey()
  96.     if k == ("LEFT" | "UP") then
  97.       {
  98.       or := r
  99.       oc := c
  100.       oi := i
  101.       i -:= 1
  102.       r -:= 1
  103.       if i < 1 then { i := 1 ; r := y+1 ; next }
  104.       writes(at(or,oc),"\e[0m",left(jects[oi],widest-2))
  105.       }
  106.     if k == ("RIGHT" | "DOWN") then
  107.       {
  108.       or := r
  109.       oc := c
  110.       oi := i
  111.       i +:= 1
  112.       r +:= 1
  113.       if i > *jects then { i := *jects ; r := y + *jects ; next }
  114.       writes(at(or,oc),"\e[0m",left(jects[oi],widest-2))
  115.       }
  116.     if *k = 3 then 
  117.       {
  118.       or:= r
  119.       oc:= c
  120.       oi:= i
  121.       i := spin(i,k[2],jects)
  122.       r := y + i
  123.       (oi = i) | writes(at(or,oc),"\e[0m",left(jects[oi],widest-2))
  124.       }
  125.     if k == "ENTER" then { choice := i ; break }
  126.     if k == "\"?\"" then 
  127.       { 
  128.       help()
  129.       write("\e[2J\e[H",company," | ",&dateline,
  130.         " | ",&host," | ",username)
  131.       write("\e[1;7m",title,"\e[0m")
  132.       uclist(y,x,jects)
  133.       writes(at(y+1,x+2),"\e[1m",jects[1],"\e[0m")
  134.       next  
  135.       }
  136.     if k == ff then
  137.       {
  138.       write("\e[2J\e[H",company," | ",&dateline,
  139.         " | ",&host," | ",username)
  140.       write("\e[1;7m",title,"\e[0m")
  141.       uclist(y,x,jects)
  142.       writes(at(y+1,x+2),"\e[1m",jects[1],"\e[0m")
  143.       }
  144.     }
  145.   command := verbs[i]
  146.   if command == "q" then
  147.     {
  148.     while remove("menu.tmp")
  149.     stop(at(23,1),"Quit")
  150.     }
  151.   if any('[]',command) then
  152.     {
  153.     command := command[2:0] || " >menu.tmp"
  154.     system(command)
  155.     results := []
  156.     most  := 0
  157.     in := open("menu.tmp")
  158.     every line := !in do
  159.       {
  160.       most <:= *line
  161.       if *results < 10 then put(results,line)
  162.       }
  163.     close(in)
  164.     put(results,center("Press <ENTER>",most))
  165.     c := (80 - most) / 2
  166.     r := 12 - (*results / 2)
  167.     uclist(r,c,results)
  168.     getch()
  169.     }
  170.   if match("?",command) then
  171.     {
  172.     command := command[2:0] || " >menu.tmp"
  173.     system(command)
  174.     command := viewer || " menu.tmp"
  175.     system(command)
  176.     } else {
  177.     system(command)
  178.     }
  179.   }
  180.   end
  181.  
  182. #
  183. # spin the menu to find the next match
  184. #
  185. procedure spin(i,k,menu)
  186.   max := *menu + 3
  187.   old := i
  188.   every 1 to max do
  189.     {
  190.     i +:= 1
  191.     if i > *menu then i := 1
  192.     if match(map(k),map(menu[i][1])) then return i
  193.     }
  194.   return old
  195.   end
  196.  
  197. #
  198. # instant help from pressing ?
  199. #
  200. procedure help()
  201.   write("\e[2J\e[HThe Easy Menu for Unix")
  202.   write("")
  203.   write("The menus appear in little boxes and are usable with")
  204.   write("most types of VT terminal emulation. You can navigate")
  205.   write("between the entries using the arrows or by pressing")
  206.   write("the first letter of the entry and then ENTER.")
  207.   write("")
  208.   write("In some cases the output would normally just role by,")
  209.   write("but it was captured to a scratch file and put into a")
  210.   write("file viewer. The file viewer recognizes the following")
  211.   write("keys:")
  212.   write("")
  213.   write("SPACE     = next page")
  214.   write("BACKSPACE = prior page")
  215.   write("DOWNARROW = next line")
  216.   write("UPARROW   = prior line")
  217.   write("RIGHTARROW= move/pan right 20 characters")
  218.   write("LEFTARROW = move/pan left  20 characters")
  219.   write("q         = quit")
  220.   write("?         = displays this help screen")
  221.   write("")
  222.   write("Press any key to continue")
  223.   getch()
  224.   end
  225.  
  226. #
  227. # parse a string into a list with respect to a delimiter
  228. #
  229. procedure parse(line,delims)  
  230.   static chars
  231.   chars  := &cset -- delims
  232.   tokens := []
  233.   line ? while tab(upto(chars)) do put(tokens,tab(many(chars)))
  234.   return tokens
  235.   end
  236.  
  237. #
  238. # prompt for an input string
  239. #
  240. procedure input(prompt)       
  241.   writes(prompt)
  242.   return read()
  243.   end
  244.  
  245. #
  246. # THIS ROUTINE SETS THE CURSOR TO A GIVEN X (COL) Y(ROW) SCREEN LOCATION
  247. #
  248. procedure at(y,x)          # 11p
  249.   return "\e[" || y || ";" || x || "f"
  250.   end
  251.   
  252. #
  253. # box input routine for universe client
  254. # requires input and at for screen input
  255. #
  256. procedure ucinput(row,column,prompt)
  257.   static ur, ul, lr, ll, vb, hb, gon, goff, device
  258.   initial {
  259.       device := getenv("TERM")
  260.       if match(("vt"|"xt"),device) then
  261.         {
  262.             ur := "k"      # upper right corner
  263.         ul := "l"      # upper left corner
  264.         lr := "j"      # lower right corner
  265.         ll := "m"      # lower left corner
  266.         vb := "x"      # Vertical bar
  267.         hb := "q"      # horizontal bar
  268.        gon := "\e(0"   # graphics mode on
  269.       goff := "\e(B"   # graphic mode off
  270.         } else {
  271.             ur := "`"      # upper right corner
  272.         ul := "_"      # upper left corner
  273.         lr := "^"      # lower right corner
  274.         ll := "]"      # lower left corner
  275.         vb := "2"      # Vertical bar
  276.         hb := "K"      # horizontal bar
  277.        gon := "\e[11m" # graphics mode on
  278.       goff := "\e[10m" # graphic mode off
  279.         }
  280.       }
  281.  
  282.   width   := *prompt + 2
  283.   message := gon || vb || goff || center(prompt,width) || gon || vb || goff
  284.   writes(at(row,column),gon,ul,repl(hb,width),ur,goff)
  285.   writes(at(row+1,column),message)
  286.   writes(at(row+2,column),gon,vb,repl(" ",width),gon,vb,goff)
  287.   writes(at(row+3,column),gon,ll,repl(hb,width),lr,goff)
  288.   return input(at(row+2,column+3))
  289.   end
  290.  
  291. #
  292. # display a list in a box in universe client
  293. # requires the at video routine
  294. #
  295. procedure uclist(row,column,lines)
  296.   static ur, ul, lr, ll, vb, hb, gon, goff, device
  297.   initial {
  298.       device := getenv("TERM")
  299.       if match(("vt"|"xt"),device) then
  300.         {
  301.             ur := "k"      # upper right corner
  302.         ul := "l"      # upper left corner
  303.         lr := "j"      # lower right corner
  304.         ll := "m"      # lower left corner
  305.         vb := "x"      # Vertical bar
  306.         hb := "q"      # horizontal bar
  307.        gon := "\e(0"   # graphics mode on
  308.       goff := "\e(B"   # graphic mode off
  309.         } else {
  310.             ur := "`"      # upper right corner
  311.         ul := "_"      # upper left corner
  312.         lr := "^"      # lower right corner
  313.         ll := "]"      # lower left corner
  314.         vb := "2"      # Vertical bar
  315.         hb := "K"      # horizontal bar
  316.        gon := "\e[11m" # graphics mode on
  317.       goff := "\e[10m" # graphic mode off
  318.           }
  319.         }
  320.  
  321.   width   := 0
  322.   every item := !lines do width <:= *item
  323.   width  +:= 2
  324.   heap    := copy(lines)
  325.   writes(at(row,column),gon,ul,repl(hb,width),ur,goff)
  326.   every point := row+1 to row + *lines do
  327.     {
  328.     message := gon || vb || goff || center(pop(heap),width) || gon || vb || goff
  329.     writes(at(point,column),message)
  330.     }
  331.   writes(at(point+1,column),gon,ll,repl(hb,width),lr,goff)
  332.   end
  333.  
  334. #
  335. # output a message box and prompt for any key
  336. # requires the at video routines
  337. #
  338. procedure ucmessage(row,column,prompt)
  339.   static ur, ul, lr, ll, vb, hb, gon, goff, device
  340.   initial {
  341.       device := getenv("TERM")
  342.       if match(("vt"|"xt"),device) then
  343.         {
  344.             ur := "k"      # upper right corner
  345.         ul := "l"      # upper left corner
  346.         lr := "j"      # lower right corner
  347.         ll := "m"      # lower left corner
  348.         vb := "x"      # Vertical bar
  349.         hb := "q"      # horizontal bar
  350.        gon := "\e(0"   # graphics mode on
  351.       goff := "\e(B"   # graphic mode off
  352.         } else {
  353.             ur := "`"      # upper right corner
  354.         ul := "_"      # upper left corner
  355.         lr := "^"      # lower right corner
  356.         ll := "]"      # lower left corner
  357.         vb := "2"      # Vertical bar
  358.         hb := "K"      # horizontal bar
  359.        gon := "\e[11m" # graphics mode on
  360.       goff := "\e[10m" # graphic mode off
  361.         }
  362.       }
  363.  
  364.   width   := *prompt + 2
  365.   message := gon || vb || goff || center(prompt,width) || gon || vb || goff
  366.   writes(at(row,column),gon,ul,repl(hb,width),ur,goff)
  367.   writes(at(row+1,column),message)
  368.   writes(at(row+2,column),gon,vb,goff,center("Press Any Key",width),gon,vb,goff)
  369.   writes(at(row+3,column),gon,ll,repl(hb,width),lr,goff)
  370.   return getch()
  371.   end
  372.  
  373. #
  374. # detects keys from a LAWSON UNIVERSE client
  375. #
  376. procedure getkey()
  377.   k := getch()
  378.   if k == "\x18" then return "F11"
  379.   if k == "\d"   then return "DEL"
  380.   if k == "\n"   then return "ENTER"
  381.   if k == "\t"   then return "TAB"
  382.   if k == "\r"   then return "RETURN"
  383.   (k == "\e") | (return image(k))
  384.   k2 := getch()
  385.   (k2 == "[") | (k2 == "O") | return image(k || k2)
  386.   k3 := getch()
  387.   case k2 of
  388.     {
  389.     "[" : case k3 of {
  390.              "A" : return "UP"
  391.              "B" : return "DOWN"
  392.              "C" : return "RIGHT"
  393.              "D" : return "LEFT"
  394.              "V" : return "PGUP"
  395.              "U" : return "PGDN"
  396.              "4" : { getch() ; return "INS" }
  397.              default : return image(k || k2 || k3)
  398.              }
  399.     "O" : case k3 of {
  400.              "P" : return "F1"
  401.              "Q" : return "F2"
  402.              "R" : return "F3"
  403.              "S" : return "F4"
  404.              "T" : return "F5"
  405.              "U" : return "F6"
  406.              "V" : return "F7"
  407.              "W" : return "F8"
  408.              "X" : return "F9"
  409.              "Y" : return "F10"
  410.              "E" : return "STAB"
  411.              "]" : return "HOME"
  412.              "^" : return "END"
  413.              "o" : return "KP-"
  414.              default : return image(k || k2 || k3)
  415.              }
  416.     default : return image(k || k2 || k3)
  417.     }
  418.   return "?" || image(k || k2 || k3)
  419.   end
  420.  
  421. #
  422. # pause a sec
  423. #
  424. procedure pause()
  425.   rax := ?50
  426.   ray := ?20
  427.   ucmessage(ray,rax,"Beep!")
  428.   end
  429.  
  430. ######################   END OF PROGRAM   #########################
  431.  
  432.  
  433. Chris Tenaglia   (system manager)     |  The future foretold,
  434. Medical College of Wisconsin          |  The past explained,
  435. 8701 W. Watertown Plank Rd.           |  The present largely appologized for.
  436. Milwaukee, WI 53226   (414)456-8765   |  Organon to the Doctor
  437.  
  438.  
  439.